home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctj8508.arc / KWIC.PLI < prev    next >
Text File  |  1986-09-14  |  3KB  |  118 lines
  1. kwic:proc options(main);
  2.   /* KWIC (Keyword in Context) system.  */
  3.   /* create or augment list of noise words, ie words which
  4.      are ignored for indexing, setting them up in an ordered
  5.      tree structure, eliminating duplicates */ 
  6. dcl (infile,outfile) char(14) var;
  7. dcl (incount, outcount,i,j,k) bin fixed;
  8. dcl  in file,
  9.      out file;
  10. dcl  inrec char(20) varying;
  11. dcl  (inline,outrec) char (250) varying;
  12. %include 'wordstr';
  13.  
  14. PUT list ('KWIC (Keyword-in-context) system');
  15. Put skip list ('build or augment list of noise words.');
  16.  
  17. PUT skip list ('First read list of predefined noise words.');
  18. PUT skip list ('Enter name of input file ');
  19. GET edit(infile)(A);
  20. PUT skip list ('Enter name of output file ');
  21. GET edit(outfile)(A);
  22. put skip(2);
  23. open file(in) stream input title(infile);
  24. open file(out) stream output title(outfile) print;
  25. on endfile (in) begin;
  26.  put skip(3) list('number of records input = ',incount);
  27.  go to exit;
  28. end;
  29.  
  30. /* general initialization */
  31. start=null;
  32. p=addr(start);
  33. ioloop: 
  34. do incount = 0 by 1;
  35.  get file(in) list (inrec);
  36.  put list (inrec);
  37.  call find;
  38. end ioloop;
  39. exit:
  40. close file(in);
  41.  
  42. put skip list ('enter file to be scanned for more words ');
  43. get list (infile);
  44. open file(in) title(infile) stream input;
  45. on endfile (in) begin;
  46.  put skip(3) list('number of records processed = ',incount);
  47.  go to exit2;
  48. end;
  49.  
  50. ioloop2: 
  51. do incount = 0 by 1;
  52.  read file(in) into (inline);
  53.  /* remove all special characters and convert to upper case */
  54.  outrec=translate(inline,
  55.                 '                                     
  56.                             ABCDEFGHIJKLMNOPQRSTUVWXYZ      
  57. ABCDEFGHIJKLMNOPQRSTUVWXYZ     ');
  58.  PUT skip list(inline);
  59.  /* pick out each word */
  60.  j=1;
  61.  do while(j<length(inline));
  62.   do j = j to length(inline) while(substr(outrec,j,1)=' ');
  63.   end;
  64.   do k = j to length(inline) while(substr(outrec,k,1)^=' ');
  65.   end;
  66.   if j<length(inline)
  67.   then do;
  68.       inrec=substr(outrec,j,k-j);
  69.       call find;
  70.        end;
  71.   j=k+1;
  72.  end;
  73. end ioloop2;
  74. signal endfile(in);
  75. exit2:
  76. /* logical end-of-program */
  77.  
  78. call traverse(start);
  79. /* logical end of program */
  80.  
  81.  
  82. find:proc;
  83.  /* find word in binary tree */
  84.  p = start;
  85.  p2=addr(start);
  86.  do while(p^=null&word^=inrec);
  87.   if word<inrec
  88.   then do;
  89.         p2=addr(higher);
  90.         p=higher;
  91.        end;
  92.   else do;
  93.         p2=addr(lower);
  94.         p=lower;
  95.        end;
  96.  end;
  97.  if p=null
  98.  then do;
  99.        allocate wordlist set(p);
  100.        link=p;
  101.        lower=null;
  102.        higher=null;
  103.        word=inrec;
  104.       end;
  105.  end find;
  106.  traverse:proc(pstart) recursive;
  107.   dcl pstart ptr;
  108.   %include 'wordstr';
  109.   p = pstart;
  110.   if lower^=null
  111.   then call traverse(lower);
  112.   put list(word);
  113.   put file(out) list(word);
  114.   if higher^=null
  115.   then call traverse(higher);
  116.  end traverse; 
  117. end kwic;
  118.